home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD Concept 6
/
CD Concept 06.iso
/
mac
/
UTILITAIRE
/
Little Smalltalk v3.1.4
/
C Source
/
Sources
/
tclprim.c
< prev
next >
Wrap
Text File
|
1995-01-26
|
20KB
|
766 lines
/*
Little Smalltalk, version 3
Written by Tim Budd, Oregon State University, June 1988
TCL window primitives
based on winprim.c written by tim budd, january 1989
Changes for use with Symantec(TM) Think Class Library
and sundry fixes and enhancements by Julian Barkway,
⌐August 1994, all rights reserved.
(TCL interface largely call-compatible with StdWin.)
*/
# include <stdio.h>
# include <stdlib.h>
# include <string.h>
# include "env.h"
# include "glue.h"
# include "memory.h"
# include "names.h"
# include <time.h>
# include "macio.h"
# include "memory.proto.h"
# include "names.proto.h"
# include "news.proto.h"
# include "tclprim.proto.h"
extern object trueobj, falseobj;
extern boolean parseok;
extern int initial;
/* report a fatal system error */
noreturn sysError(char *s1, char *s2)
{ char buffer[1024];
if (initial) {
ignore fprintf(stderr,"%s\n%s\n", s1, s2);
}
else {
ignore sprintf(buffer,"%s %s", s1, s2);
wperror(buffer);
}
ignore abort();
}
/* report a fatal system error */
noreturn sysWarn(char *s1, char *s2)
{ char buffer[1024];
if (initial) {
ignore fprintf(stderr,"%s\n%s\n", s1, s2);
}
else {
ignore sprintf(buffer,"%s %s", s1, s2);
wperror(buffer);
}
}
void compilWarn(char *selector, char *str1, char *str2)
{ char buffer[1024];
if (initial) {
ignore fprintf(stderr,"compiler warning: Method %s : %s %s\n",
selector, str1, str2);
}
else {
ignore sprintf(buffer,"warn: %s %s", str1, str2);
wmessage(buffer);
}
}
void compilError(char *selector, char *str1, char *str2)
{ char buffer[1024];
if (initial) {
ignore fprintf(stderr,"compiler error: Method %s : %s %s\n",
selector, str1, str2);
}
else {
ignore sprintf(buffer,"error: %s %s", str1, str2);
wmessage(buffer);
}
parseok = false;
}
noreturn dspMethod(char *cp, char *mp)
{
/*ignore fprintf(stderr,"%s %s\n", cp, mp);*/
}
void givepause(void)
{ char buffer[80];
if (initial) {
ignore fprintf(stderr,"push return to continue\n");
ignore gets(buffer);
}
else
wmessage("wait to continue");
}
static object newPoint(int x, int y)
{ object newObj;
newObj = allocObject(2);
setClass(newObj, globalSymbol("Point"));
basicAtPut(newObj, 1, newInteger(x));
basicAtPut(newObj, 2, newInteger(y));
return newObj;
}
static object newRect (short l, short t, short r, short b)
{
object newObj;
newObj = allocObject (4);
setClass (newObj, globalSymbol ("Rectangle"));
basicAtPut (newObj, 1, newInteger (t));
basicAtPut (newObj, 2, newInteger (l));
basicAtPut (newObj, 3, newInteger (b));
basicAtPut (newObj, 4, newInteger (r));
return newObj;
}
/* windows and text edit buffers are maintained in
a single structure */
/* - retained for compatibility purposes. TextEdit pointers are now */
/* stored as Smalltalk strings. Window pointers are unaffected - JRB */
# define WINDOWMAX 15
static struct {
WINDOW *w;
TEXTEDIT *tp;
} ws[WINDOWMAX];
/* All menu pointers are now stored as a character string */
/* in the Smalltalk object itself - JRB */
/* current event record */
static EVENT evrec;
static short openWindCount = 0; /* No. of windows currently open */
#define NO_WINDOWS -1
//========================================================================
// Return the index of the currently active window.
//========================================================================
static int findWindow(WINDOW *w)
{
int i;
if (openWindCount == 0)
return (NO_WINDOWS);
for (i = 0; i < WINDOWMAX; i++)
if (w == ws[i].w)
return(i);
//****sysError ("can't find window",""); /* Is this really a fatal error? */
return (0);
}
//========================================================================
// drawproc () is redundant but retained for compatibility purposes.
//========================================================================
static void drawproc(WINDOW *w, int left, int top, int right, int bottom)
{
return;
}
//========================================================================
// Perform a TCL primitive.
//========================================================================
object sysPrimitive(int primitiveNumber, object *arguments)
{ int i, j, k;
int p1, p2, p3, p4;
char *c;
WINDOW *w;
object returnedObject = nilobj;
// A union is used in order to store menu and pane pointers in a Smalltalk
// string, removing the need for an array in the C code.
union {
char *charPtr;
TEXTEDIT **tedt;
MENU **menuPtr;
WINDOW **winPtr; /* Currently unused */
CURSOR **csr;
} uu;
TEXTEDIT *te;
switch(primitiveNumber) {
case 160: /* window open */
// Extensively modified to accomodate window opening with
// sizing parameters
{
short action, left, top, width, height;
i = intValue(arguments[0]); /* win number */
if (ws[i].w)
break; /* already open */
action = intValue (arguments [1]); /* action */
c = charPtr (arguments[2]); /* title */
/* win type (arguments[3]) not used */
switch (action) {
case 1:
ws[i].w = w = wopen (c, NULL);
break;
case 2:
left = intValue (arguments [4]);
top = intValue (arguments [5]);
width = intValue (arguments [6]);
height = intValue (arguments [7]);
ws[i].w = w = wopentosize (c, left, top, width, height);
break;
}
ws[i].tp = 0;
openWindCount++;
}
break;
case 161: /* variety of simple window actions */
i = intValue(arguments[0]); /* win number */
if (! (w = ws[i].w)) break; /* return if no open */
j = intValue(arguments[1]); /* action */
switch(j) {
case 1:
ws[i].w = NULL;
wclose (w);
openWindCount--;
break;
/***********case 2: wbegindrawing(w); break;***/ /* Moved to prim 168 */
/***********case 3: wenddrawing(w); break;*****/
case 4: wsetactive(w); break;
case 5: if (ws[i].tp) tedraw(ws[i].tp); break;
case 6: /* Return the current size of the window */
wgetwinsize(w, &i, &j);
returnedObject = newPoint(i, j);
break;
case 7: /* Return the window's position in the global scheme of things */
wgetwinpos (w, &i, &j);
returnedObject = newPoint(i, j);
break;
case 8: /* Bring the window to the front */
windowToFront (w);
break;
case 9:
if (docDirty (w))
returnedObject = trueobj;
else
returnedObject = falseobj;
break;
case 10: /* Set window title */
c = charPtr (arguments[2]);
wsettitle (w, (unsigned char *)c);
break;
}
break;
case 162: /* one int arg actions */
i = intValue(arguments[0]); /* win number */
if (! (w = ws[i].w)) break; /* return if no open */
i = intValue(arguments[1]); /* action */
if (i > 1)
uu.charPtr = charPtr (arguments [2]); /* menuPtr */
else
j = intValue (arguments [2]); /* x */
switch(i) {
case 1: /* set timer */
wsettimer(w, j); break;
case 2: /* menu attach */
wmenuattach (w, *(uu.menuPtr));
break;
case 3: /* menu detach */
wmenudetach (w, *(uu.menuPtr));
break;
}
break;
case 163: /* two int arg actions */
i = intValue(arguments[0]); /* win number */
if (! (w = ws[i].w)) break; /* return if no open */
i = intValue(arguments[1]); /* action */
j = intValue(arguments[2]); /* x */
k = intValue(arguments[3]); /* y */
switch(i) {
case 2: wsetdocsize(w, j, k); break;
case 3: wsetorigin(w, j, k); break;
}
break;
case 164: /* Cursors */
i = intValue(arguments[0]); /* Action */
switch (i) {
case 1: /* Fetch a named cursor */
c = charPtr (arguments [1]);
returnedObject = newStString ("xxxx"); /* Allocate a four-byte string */
uu.charPtr = charPtr (returnedObject);
*(uu.csr) = wfetchcursor (c);
break;
case 2: /* Show cursor */
uu.charPtr = charPtr (arguments [1]); /* CursPtr */
wsetwincursor (NULL, *(uu.csr)); /* Window not used */
break;
case 3: /* Reset to default cursor (arrow) */
setArrowCursor ();
break;
}
break;
case 165: /* Some text-related functions */
uu.charPtr = charPtr (arguments [0]); /* panePtr */
te = *(uu.tedt);
j = intValue (arguments[1]); /* action */
switch (j) {
case 1:
returnedObject = newStString (tegettext (te));
break;
case 2:
returnedObject = newStString (teGetSelectedText (te));
break;
case 3: /* Replace all text with given text */
c = charPtr (arguments [2]);
replaceAllText (te, c);
break;
case 4: /* Delete all text in a pane */
deleteAllText (te);
break;
case 5: /* Change font */
c = charPtr (arguments [2]);
setFont (te, c);
break;
case 6: /* Change point size */
k = intValue (arguments [2]);
setFontSize (te, k);
break;
case 7: /* Change type face */
k = intValue (arguments [2]);
setTypeFace (te, k);
break;
case 8: /* Set the text selection to the given range */
{
short start, end;
start = intValue (arguments [2]);
end = intValue (arguments [3]);
setTextSelection (te, (long)start, (long)end);
break;
}
case 9: /* Return the start and end positions of a selection */
{
long start, end;
getTextSelection (te, &start, &end);
returnedObject = newPoint ((short)start, (short)end);
break;
}
case 10: /* Scroll the text so that the current selection is visible */
scrollToSelection (te);
break;
}
break;
case 166: /* replace text */
uu.charPtr = charPtr (arguments [0]); /* panePtr */
te = *(uu.tedt);
tereplace (te, charPtr (arguments [1]));
/*******tereplace (te, "\n");***//* Leave it up to the user to add a new line as required */
break;
case 167: /* get max screen area */
{
short l, t, r, b;
getMaxScreenArea (&l, &t, &r, &b);
returnedObject = newRect (l, t, r, b);
break;
}
case 168: /* Window panes */
{
short action, l, t, r, b, sh, sv, paneType, lineLength, protection;
action = intValue (arguments [0]); /* action */
if (action == 1)
i = intValue (arguments [1]); /* win number */
else {
uu.charPtr = charPtr (arguments [1]); /* panePtr */
te = *(uu.tedt);
}
switch (action) {
case 1: /* Attach a pane to a window */
paneType = intValue (arguments [2]); /* 1 - text, 2 - select, 3 - graphics */
l = intValue (arguments [3]);
t = intValue (arguments [4]);
r = intValue (arguments [5]);
b = intValue (arguments [6]);
sh = intValue (arguments [7]);
sv = intValue (arguments [8]);
lineLength = intValue (arguments [9]); /* in pixels */
switch (paneType) {
case 1: /* Standard text */
te = addTextPane (ws[i].w, l, t, r, b, sh, sv, lineLength);
break;
case 2: /* Text selection pane */
protection = intValue (arguments [10]); /* 0/1 - off/on */
te = addSelPane (ws[i].w, l, t, r, b, sh, sv, lineLength);
break;
case 3: /* Graphics */
te = addGraphicsPane (ws[i].w, l, t, r, b, sh, sv);
break;
}
returnedObject = newStString ("xxxx"); /* Allocate a four-byte string */
uu.charPtr = charPtr (returnedObject);
*(uu.tedt) = te; /* then insert the te ptr using a union */
break;
case 2: /* Return current size of pane */
getPaneSize (te, (short *)&i, (short *)&j);
returnedObject = newPoint (i, j);
break;
case 3: /* Draw pane */
paneType = intValue (arguments [2]);
if (paneType != 3)
tedraw (te);
else
; /* Drawing handled by Smalltalk */
break;
case 4:
wbegindrawing (te); /* Changed from StdWin prototype to allow */
break; /* output to be directed to different panes */
case 5:
wenddrawing (te);
break;
}
}
break;
case 170: getevent: /* get next event */
wgetevent(&evrec);
i = findWindow (evrec.window);
if (i > 0) {
if (ws[i].tp && teevent (ws[i].tp, &evrec))
goto getevent;
}
returnedObject = newInteger (evrec.type);
break;
case 171: /* integer event info */
i = intValue(arguments[0]);
switch(i) {
case 1: /* event window */
j = findWindow (evrec.window);
if (j == NO_WINDOWS)
j = 0;
break;
case 2: /* event menu */
j = evrec.u.m.id;
break;
case 3: /* menu item */
j = evrec.u.m.item + 1;
break;
case 4: /* char typed */
j = evrec.u.character;
break;
case 5: /* mouse y */
j = evrec.u.where.v;
break;
case 6: /* mouse button */
j = evrec.u.where.button;
break;
case 7: /* mouse click number */
j = evrec.u.where.clicks;
break;
case 8: /* char typed */
j = evrec.u.character;
break;
case 9: /* command typed */
j = evrec.u.command;
break;
}
returnedObject = newInteger(j);
break;
case 172: /* more general event info */
i = intValue(arguments[0]);
switch(i) {
case 1: /* mouse down point */
returnedObject = newPoint(evrec.u.where.h,
evrec.u.where.v);
break;
}
break;
case 180: /* new menu */
i = intValue (arguments [0]); /* menu number */
c = charPtr (arguments [1]); /* title */
j = intValue (arguments [2]); /* Pop-up menu? */
returnedObject = newStString ("xxxx"); /* Allocate a four-byte string */
uu.charPtr = charPtr (returnedObject);
if (j)
*(uu.menuPtr) = popUpMenuCreate (i);
else
*(uu.menuPtr) = wmenucreate (i, c);
break;
case 181: /* menu item */
uu.charPtr = charPtr (arguments [0]); /* menuPtr */
c = charPtr (arguments [1]); /* title */
if (isInteger (arguments[2]))
j = intValue (arguments[2]);
else
j = -1;
wmenuadditem (*(uu.menuPtr), c, j);
break;
case 182: /* check menu items */
uu.charPtr = charPtr (arguments [0]); /* menuPtr */
j = intValue (arguments [1]); /* item number */
k = intValue (arguments [2]); /* action */
p1 = intValue (arguments [3]); /* flag */
switch (k) {
case 1: /* enable/disable */
wmenuenable (*(uu.menuPtr), j - 1, p1); break;
case 2: /* check/no check */
wmenucheck (*(uu.menuPtr), j - 1, p1); break;
}
break;
case 183: /* Select from a pop-up menu */
{
short menu, item;
uu.charPtr = charPtr (arguments [0]); /* menuPtr */
j = intValue (arguments [1]); /* top */
k = intValue (arguments [2]); /* left */
selectFromPopUpMenu (*(uu.menuPtr), j, k, &menu, &item);
returnedObject = newInteger (item);
break;
}
case 184: /* Menu/Menu Item disposal */
uu.charPtr = charPtr (arguments [0]); /* menuPtr */
i = intValue (arguments [1]); /* action */
switch (i) {
case 1:
wmenudelete (*(uu.menuPtr));
break;
case 2:
k = intValue (arguments [2]); /* menu item number */
removeMenuItem (*(uu.menuPtr), k);
break;
}
break;
case 190: /* print text graphics */
i = intValue(arguments[0]); /* x */
j = intValue(arguments[1]); /* y */
c = charPtr(arguments[2]); /* text */
wdrawtext(i, j, c, strlen(c));
break;
case 192: /* points */
i = intValue(arguments[0]); /* action */
p1 = intValue(arguments[1]);
p2 = intValue(arguments[2]);
switch(i) {
case 1: /* draw line */
drawLineTo (p1, p2); break;
case 2: /* Move to the given point */
moveTo (p1, p2); break;
case 3: /* Draw a pixel at the given point */
drawPixel (p1, p2); break;
}
break;
case 193: /* circles and the like */
i = intValue(arguments[0]); /* action */
p1 = intValue(arguments[1]);
p2 = intValue(arguments[2]);
p3 = intValue(arguments[3]);
switch(i) {
case 1: /* draw circle */
wdrawcircle(p1,p2,p3); break;
case 2: /* draw char */
wdrawchar(p1,p2,p3); break;
}
break;
case 194: /* rectangles */
i = intValue(arguments[0]); /* action */
p1 = intValue(arguments[1]);
p2 = intValue(arguments[2]);
p3 = intValue(arguments[3]);
p4 = intValue(arguments[4]);
switch(i) {
case 1: /* draw box */
wdrawbox(p1,p2,p3,p4); break;
case 2: /* paint */
wpaint(p1,p2,p3,p4); break;
case 3: /* erase */
werase(p1,p2,p3,p4); break;
case 4: /* invert */
winvert(p1,p2,p3,p4); break;
}
break;
case 195: /* shading */
i = intValue(arguments[0]); /* action */
p1 = intValue(arguments[1]);
p2 = intValue(arguments[2]);
p3 = intValue(arguments[3]);
p4 = intValue(arguments[4]);
j = intValue(arguments[5]);
switch(i) {
case 1: /* shading */
wshade(p1,p2,p3,p4,j); break;
}
break;
case 200: /* issue a message */
c = charPtr(arguments[0]);
wmessage(c);
break;
case 201: /* ask a question */
{
char replybuffer[120];
strcpy (replybuffer, charPtr (arguments[1]));
if ( waskstr (charPtr (arguments[0]), replybuffer, 120) )
returnedObject = newStString (replybuffer);
else
returnedObject = newStString ("\0");
}
break;
case 202: /* ask a binary question */
i = waskync(charPtr(arguments[0]), intValue(arguments[1]));
if (i == 1)
returnedObject = trueobj;
else if (i == 0)
returnedObject = falseobj;
break;
case 203: /* ask for a file - changed to allow specification of one of three */
{ /* file types to use to mask out types that aren't required */
char replybuffer [120];
strcpy (replybuffer, charPtr (arguments [1]));
if ( waskfile (charPtr (arguments [0]), replybuffer, 120,
intValue (arguments [2]), intValue (arguments [3])) )
returnedObject = newStString (replybuffer);
else
returnedObject = nilobj;
}
break;
case 204: /* error message */
wperror(charPtr(arguments[0]));
break;
case 205: /* beep */
wfleep();
break;
case 206: /* Save/Load text pane contents */
{
short action, fileNum;
uu.charPtr = charPtr (arguments [0]); /* panePtr */
te = *(uu.tedt);
action = intValue (arguments [1]); /* action */
fileNum = intValue (arguments [2]); /* file number - file must be open */
if (action)
saveTE (te, fileNum);
else
loadTE (te, fileNum);
break;
}
case 207: /* Get file info after receipt of an Open Document event */
/* Returns full path with Smalltalk file type prepended */
/* (for drag'n'drop support). */
{
char fullPath [255], str [255];
long fType;
short ft;
if (getFileInfo (fullPath, &fType)) {
macFileTypeToSt (fType, ft);
sprintf (str, "%d%s", ft, fullPath);
returnedObject = newStString (str);
}
else
returnedObject = nilobj;
}
case 210: /* Date and time functions */
// Uses 'standard' C date'n'time functions but I've a feeling that Symantec/Think C
// goes its own way on this one so they may not be as standard as you'd think....
{
time_t cDateTime;
struct tm *theTime;
char str [30];
time (&cDateTime);
theTime = localtime (&cDateTime);
i = intValue(arguments[0]); /* action */
switch (i) {
case 1: /* Current date and time (string) */
returnedObject = newStString (asctime (theTime));
break;
case 2: /* Day of week (numeric) */
strftime (str, 30, "%w", theTime);
j = (atoi (str)) + 1;
returnedObject = newInteger (j);
break;
case 3: /* Day of month numeric) */
strftime (str, 30, "%d", theTime);
returnedObject = newInteger (atoi (str));
break;
case 4: /* Month number */
strftime (str, 30, "%m", theTime);
returnedObject = newInteger (atoi (str));
break;
case 5: /* Year (4 digits) */
strftime (str, 30, "%Y", theTime);
returnedObject = newInteger (atoi (str));
break;
}
break;
}
case 254:
{
char str [30];
getVersionNumber (str);
returnedObject = newStString (str);
break;
}
case 255: /* set debug */
i = intValue(arguments[0]); /* action */
if (i) /* Changed to allow debugging to be switched */
debugging = true; /* on and off as required */
else
debugging = false;
break;
default:
fprintf (stderr, "primitive not implmented yet %d\n", primitiveNumber);
sysError("primitive not done","");
}
return returnedObject;
}